COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	The following declarations are used in all of METAFONT's modules.
C00009 00003	Declarations internal to MFSYS
C00015 00004	Declarations internal to MFNTRP
C00031 00005	Declarations internal to MFRAST
C00039 00006	Declarations internal to MFOUT
C00045 00007	Macros for TOPS20 extended memory
C00056 ENDMK
C⊗;
comment The following declarations are used in all of METAFONT's modules.
Only brief explanatory comments appear here -- fuller documentation appears
in each individual module.

This page lists several standard abbreviation conventions.
The next four pages include declarations of everything external that is
internal to MFSYS, MFNTRP, MFRAST, MFOUT, respectively;

require "⊂⊃⊂⊃" delimiters; "used for macros"
define # = ⊂;comment⊃; "used henceforth instead of quoted comments like this"

comment Here are various compile-time switches which indicate how you
	would like your Metafont to be configured.  Choose one from
	each set of choices;

comment What OS are you running under?;
define WAITS = true, TENEX = false, TOPS20 = false;

comment Do you want your proofmode output to be Press or XGP or DVI?;
define XGP = true, PRESS = false, DVI = false;

comment Do you want FNT's or VNT's?;
define VNTs = true, FNTs = false;

comment Do you want your on-line display to be Alto-ADIS or DataDisc?;
define DATADISC = true, ADIS = false, NOONLINE = false;

comment Do you want Alphatype font capability?;
define ALPHATYPEMODE = true;

comment Do you want Dover-style output modes supported?;
define DOVERMODES = true;

define SPECRAST = true # this makes raster for large Alphatype fonts;
define XMEM = false # makes even larger raster, only for use on 2060's; 
define ENABLED = false # report any arithmetic exceptions, floating or integer;
comment currently, ALPHATYPEMODE conflicts with ENABLED, so don't turn both on;

define IFWAITS = ⊂ifc WAITS thenc⊃;
define ENDWAITS = ⊂endc⊃;
define IFTENEX = ⊂ifc TENEX thenc⊃;
define ENDTENEX = ⊂endc⊃;
define IFTOPS20 = ⊂ifc TOPS20 thenc⊃;
define ENDTOPS20 = ⊂endc⊃;

define IFPRESS = ⊂ifc PRESS thenc⊃;
define ENDPRESS = ⊂endc⊃;
define IFXGP = ⊂ifc XGP thenc⊃;
define ENDXGP = ⊂endc⊃;
define IFDVI = ⊂ifc DVI thenc⊃;
define ENDDVI = ⊂endc⊃;

define IFVNT = ⊂ifc VNTs thenc⊃;
define ENDVNT = ⊂endc⊃;
define IFFNT = ⊂ifc FNTs thenc⊃;
define ENDFNT = ⊂endc⊃;
define IFADIS = ⊂ifc ADIS thenc⊃;
define ENDADIS = ⊂endc⊃;
define IFDATADISC = ⊂ifc DATADISC thenc⊃;
define ENDDATADISC = ⊂endc⊃;
define IFNOONLINE = ⊂ifc NOONLINE thenc⊃;
define ENDNOONLINE = ⊂endc⊃;

define IFDOVERMODES = ⊂ifc DOVERMODES thenc⊃;
define ENDDOVERMODES = ⊂endc⊃;

define IFSPECRAST = ⊂ifc SPECRAST thenc⊃;
define ENDSPECRAST = ⊂endc⊃;
define IFXMEM = ⊂ifc XMEM thenc⊃;
define ENDXMEM = ⊂endc⊃;

IFTOPS20 define inchwl = ⊂intty⊃; ENDTOPS20

define nextline = ⊂('15&'12)⊃ # carriage-return and line-feed in print commands;
define eps = ⊂10↑-5⊃    # a rather small but positive number;
define thru = ⊂step 1 until⊃ # abbreviation for for clauses;
define loop = ⊂while true do⊃ # abbreviation for loops exited by "done" or "return";
integer floorignore # used for truncation in mid-expression;
define floor(x) = ⊂(floorignore←x)⊃ # the function $\lfloor x\rfloor$;
define infty = 100000 # infinity (approximately);
define DEBUGONLY = ⊂comment⊃ # changed to ⊂⊃ when debugging METAFONT;
define SHOWMEM = ⊂comment⊃ # changed to ⊂⊃ when looking at mem usage;
DEBUGONLY external procedure bail # the SAIL debugger in case of need;
require 500 system_pdl # the default (192) is too small;

define bitsperwd = 36	     # word size in this implementation;
comment The METAFONT programs can be adapted for machines with somewhat smaller
word size (e.g. 32 bits), so all word-size dependent quantities are
defined symbolically to aid in this conversion;

define internaldef = ⊂comment⊃ #
	When a quantity is defined below, e.g. "define hashsize=127", the
	METAFONT module where it is appropriate to introduce the quantity will
	include an internal definition for documentation purposes,
	e.g. "internaldef hashsize = 127". The internal definitions are
	not necessarily up-to-date, however... for example, the MFNTRP
	module might say "internaldef hashsize = 89" but hashsize might
	really be 127 as defined here;

define FIXTHIS = ⊂comment⊃ # marks things that still need to be done;

FIXTHIS: Make all of the METAFONT documentation crystal clear;

define saf = ⊂safe⊃ # used when an array is believed to require no bounds checks;
define simp = ⊂simple⊃ # used when SAIL can save time implementing this procedure;
DEBUGONLY redefine saf = ⊂⊃ # when debugging, belief turns to disbelief;
DEBUGONLY redefine simp = ⊂⊃ # and simplicity dies too;
comment Declarations internal to MFSYS;
external procedure quit # closes output files and terminates METAFONT;
external boolean pausing_on_errors # should METAFONT wait after error messages?;
external boolean not_nonstop # should METAFONT wait for other reasons?;
external boolean deletions_allowed # is it safe for error routine to call getnext?;
external procedure error(string s) # prints an error message;
external procedure errorstop(string s) # prints message and dies;
external procedure reportoverflow(string s; integer n)
	# for fatal errors when a METAFONT table is undersized;
define overflow(s)=⊂reportoverflow("s",s)⊃ # specifies inadequate table size;
external procedure memoverflow # overflow of the one-word memory;
external procedure vmemoverflow # overflow of the two-word memory;
external procedure confusion # METAFONT consistency check failure;

define links = 15 # number of bits per pointer;
define memsize=25000 # size of dynamic list memory, must be ≤ 2↑links;
define vmemsize=2500 # size of two-word list memory, must be << memsize;
define memreal(p)=⊂memory[location(mem[p]),real]⊃ # mem[p] as type real;
define vmemint(p)=⊂memory[location(vmem[p]),integer]⊃ # vmem[p] as integer;
SHOWMEM external integer oneused,twoused # how much memory is in use;

define fs(f) = ⊂f⊃&"s" # field size of f, in bits;
define fd(f) = ⊂f⊃&"d" # field displacement of f, in bits;
define field(f,x) = ⊂ifc fd(f)=0 thenc ((x) land (2↑fs(f)-1))
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc ((x) lsh -fd(f))
	elsec (((x) lsh -fd(f)) land (2↑fs(f)-1)) endc endc⊃ # field f of x;
define setfield(f,x,y) = ⊂ifc fd(f)=0 thenc x←(x land(-2↑fs(f)))+(y)
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc 
		x←((x lsh(bitsperwd-fd(f)))+(y))rot fd(f)
	elsec x←(((x rot -fd(f))land(-2↑fs(f)))+(y))rot fd(f) endc endc⊃
		# sets field f of x equal to y, 0 ≤ y < 2↑fs(f);
define ufield(f,x) = ⊂((x) land((1 lsh(fs(f)+fd(f)))-2↑fd(f)))⊃
		# unshifted field f of x;
define setufield(f,x,y) = ⊂x←(x land lnot((1 lsh(fs(f)+fd(f)))-2↑fd(f)))+(y)⊃
		# field f of x set to unshifted value y;
define linkd = 0 # displacement of link field;
define link(p) = ⊂field(link,mem[p])⊃ # link field of mem[p];
define setlink(p,y) = ⊂setfield(link,mem[p],y)⊃ # sets link(p)←y;
define infod = links, infos = bitsperwd-infod # definition of info field;
define info(p) = ⊂field(info,mem[p])⊃ # info field of mem[p];
define setinfo(p,y) = ⊂setfield(info,mem[p],y)⊃ # sets info(p)←y;

external integer avail # head of available space list for one-word nodes;
external integer vavail # head of available space list for two-word nodes;
define getavail(p) = ⊂begin if(p←avail)then
	begin avail←mem[avail]; SHOWMEM oneused←oneused+1; end
	else if(p←vavail)then
	begin vavail←mem[vavail]; SHOWMEM twoused←twoused+1; end
	else memoverflow; end⊃ # p ← new one-word node;
define getvavail(p) = ⊂begin if(p←vavail)then vavail←mem[vavail]
	else vmemoverflow; SHOWMEM twoused←twoused+1; end⊃ # p ← new two-wd node;
define freeavail(p) = ⊂if p<vmemsize then
	begin mem[p]←vavail; vavail←p; SHOWMEM twoused←twoused-1; end
	else begin mem[p]←avail; avail←p; SHOWMEM oneused←oneused-1; end⊃
		# node p now available;
external procedure dslist(integer p) # makes list of nodes available;

DEBUGONLY external procedure checkmem(boolean printlocs) # checks links in mem;
define wvar = memsize-1 # head of list for w-variables;
define depvar = wvar-1 # head of list for dependent variables;
define temphead = depvar-1 # temporary list head for created lists;
define main = ⊂1⊃ # area header for main program;
define firstvmem = 2, lastmem = temphead-1 # nodes not specially dedicated;
comment Declarations internal to MFNTRP;

define types=6, typed=bitsperwd-types	# type field in nodes;
define names=typed-links, named=links 	# name field in nodes;
define type(p)=⊂field(type,mem[p])⊃	# type field in node p;
define name(p)=⊂field(name,mem[p])⊃	# name field in node p;

external saf integer array mem[0:memsize-1] # dynamic list memory;
external saf real array vmem[0:vmemsize-1] # two-word list memory;
external integer curtype # the current type code appearing in the input;
external real curval # the current value appearing in the input;
external real cursize # the current pen size;
external integer curpen # the current pen type;
external string pagewarning # most recent quoted string scanned;

define innput=0	# "input";
define rel=1	# "<", ">", "=", "≠", "≤", or "≥";
define ddot=2	# "..";
define rpren=3	# ")";
define lbrace=4	# "{";
define rbrace=5	# "}";
define hashmark=6	# "#";
define comma=7	# ",";
define colon=8	# ":";
define varparam=9	# "var";
define indexparam=10 # "index";
define semi=11	# semicolon;
define quote=12	# """";
define stop=13	# "end";
define fullstop=14	# period ending a routine or subroutine;
define iff=15	# "if";
define elsse=16	# "else";
define ffi=17	# "fi";
define ident=18	# identifier;
define wxy=19	# "w", "x", or "y";
define rbrack=20	# "]";
define lbrack=21	# "[";
define digit=22	# "0", "1", ..., "9";
define pnt=23	# ".";
define apost=24	# "'";
define letter=25	# "A", "B", ..., "Z", "a", "b", ..., "z";
define equals=26	# "=";
define openq=27	# "`";
define space=28	# " " or character ignored by scanner;
define carret=29	# carriage return or form feed or "%";
define abbs=30	# "|";
define index=31	# index argument;
define lpren=32	# "(";
define char=33	# single character in constant or subroutine call;
define constant=34	# (real) constant;
define plusorminus=35	# "+" or "-";
define timesordiv=36	# "." or "*" or "⊗" or "/";
define randm=37 # "nrand";
define known=38	# variable whose value is known;
define direction=39	# "lft" or "rt" or "top" or "bot";
define dependent=40	# variable whose value is a dependency list;
define newid=41 # identifier whose type has not yet been assigned;
define independent=42	# variable whose value is independent;
define unary=43	# "sqrt" or "round" or "good";
define subroutine=44	# identifier corresponding to a stored subroutine;
define penname=45	# "cpen" or "hpen" or ... or "spen" or "epen";
define cawl=46	# "call";
define new=47	# "new";
define mfparam=48	# "charcode", "maxvr", etc.;
define contrl=49	# "proofmode", "pause", "eqtrace", etc.;
define no=50	# "no";
define draw=51	# "draw";
define ddraw=52	# "ddraw";
define subrtn=53	# "subroutine";
define param=54	# identifier that is a parameter;
define varchar=55	# "varchar";
define charlist=56 # "charlist";
define texinfo=57	# "texinfo";
define lig=58	# "lig";
define invisible=59	# "invisible";
define break=60	# "crsbreak";
define kern=61	# "kern";
define binput=62	# "binput";
define areahead=(2↑types-1)	# area header node;
define lft=0	# "lft";
define rt=1	# "rt";
define top=2	# "top";
define bot=3	# "bot";
define root=0	# "sqrt";
define sine=1	# "sind";
define cosine=2	# "cosd";
define round=3	# "round";
define good=4	# "good";
define cpen=0	# "cpen";
define hpen=1	# "hpen";
define vpen=2	# "vpen";
define lpen=3	# "lpen";
define rpen=4	# "rpen";
define spen=5	# "spen";
define epen=6	# "epen";
define badpen=7	# illegal pen type (the initial value);

define realpars=26,intpars=11, stringpars=2 # number of real, integer, and string parameters;
define penparam=realpars+4 # distinguish the first four integer parameters;
define intpar=realpars # offset used for integer parameters;
define stringpar=realpars+intpars # offset used for integer parameters;
external saf real array realparam[1:realpars] # real parameters to METAFONT;
external saf integer array intparam[intpar+1:intpar+intpars] # integer parameters;
external saf string array stringparam[stringpar+1:stringpar+stringpars] # integer parameters;
define xxtr=⊂realparam[1]⊃, xytr=⊂realparam[2]⊃, xtr=⊂realparam[3]⊃,
	yxtr=⊂realparam[4]⊃, yytr=⊂realparam[5]⊃, ytr=⊂realparam[6]⊃;
define charwd=⊂realparam[7]⊃ # width of character to be output;
define charht=⊂realparam[8]⊃ # height of character to be output;
define chardp=⊂realparam[9]⊃ # depth of character to be output;
define charic=⊂realparam[10]⊃ # italic correction of character to be output;
define safetyfactor=⊂realparam[11]⊃ # extra factor for overlap in ddraw;
define maxvr=⊂realparam[12]⊃, minvr=⊂realparam[13]⊃,
	maxvs=⊂realparam[14]⊃, minvs=⊂realparam[15]⊃ # velocity thresholds;
define epenxfactor=⊂realparam[16]⊃, epenyfactor=⊂realparam[17]⊃,
	excorr=⊂realparam[18]⊃,	eycorr=⊂realparam[19]⊃ # parameters for \&{epen}s;
define designsize=⊂realparam[20]⊃ # nominal height of font to be output,
	expressed in points;
define xresolution=⊂realparam[21]⊃, yresolution=⊂realparam[22]⊃ # of output,
	expressed in pixels per point;
define magnification=⊂realparam[23]⊃ # factor by which logical font has
	been expanded or contracted, a pure number; 
define charwx=⊂realparam[24]⊃ # x component of vector width; 
define charwy=⊂realparam[25]⊃ # y component of vector width; 
define rotation=⊂realparam[26]⊃ # font rotation in degrees; 
define hpenht=⊂intparam[intpar+1]⊃ # hpen height;
define vpenwd=⊂intparam[intpar+2]⊃ # vpen width;
define lpenht=⊂intparam[intpar+3]⊃ # lpen height;
define rpenht=⊂intparam[intpar+4]⊃ # rpen height;
define dumplength=⊂intparam[intpar+5]⊃ # length of strings for dumping;
define charcode=⊂intparam[intpar+6]⊃ # ascii code of character to be output;
define chardw=⊂intparam[intpar+7]⊃ # device width of character to be output;
define seed=⊂intparam[intpar+8]⊃ # controls random number generator;
define dumpwindow=⊂intparam[intpar+9]⊃ # number of characters in error messages;
define maxht=⊂intparam[intpar+10]⊃ # maximum height above baseline;
define fontfacebyte=⊂intparam[intpar+11]⊃ # the integer to use as the
	PARC face of the generated font;
define fontidentifier=⊂stringparam[stringpar+1]⊃ # the string to use
	as the PARC family of the generated font: for
	example, "CMR", "CMSS", "CMTT", ...;
define codingscheme=⊂stringparam[stringpar+2]⊃ # a string that describes the
	translation between characters codes and shapes in this font,
	such as "ASCII", "TEX ROMAN", ...;
external integer control # bits that control various METAFONT functions;

define hashsize = 89 # hashtable size, should be prime;
define namesize = 750 # maximum number of different identifiers, is << 2↑names;
comment The difference between 2↑names and namesize is the maximum allowable
	subscript on a w-, x-, or y-variable;
external saf integer array hashh[0:hashsize-1] # list heads for hashing;
external saf integer array hname[0:namesize-1] # first characters of identifiers;
external integer hptr # number of different identifiers currently in memory;
define bitsrem=bitsperwd mod 5 # extra bits at left of hname entries;
external boolean forcednew # identifier when looked up will not match any other;
external integer procedure idlookup(integer firstfew,length) # look for identifier;
external string procedure indexname(integer i) # symbolic name of an index value;
external string procedure idname(integer p) # produces name for printouts;

define stacksize=69 # maximum number of simultaneous input sources;
external saf string array inbufstack[0:stacksize]; external string inbuf
	# current lines being input from a character file;
external saf string array curbfstack[0:stacksize]; external string curbuf
	# the parts of inbuf that haven't yet been input;
external saf string array filenmstack[0:stacksize]; external string filename
	# the names of the current character files;
external saf integer array locstack[0:stacksize]; external integer loc
	# current scanner locations;
external saf integer array recvrystack[0:stacksize]; external integer recovery
	# information about what to do when done on each level;
external integer inptr # first unused location in input stacks;

external saf string array tokstring[0:1] # output of dumplist;
external procedure dumplist(integer p,q) # makes strings out of a token list;
external string procedure dumptokens(integer p) # simple special case of dumplist;
external simp procedure pushinput # save current input status on the stacks;
external simp procedure popinput # finish input level, restore the previous;
external integer brchar # break character stored by system input;
external integer eof # end-of-file code stored by system input;
external procedure initin # get TEX input system ready to start;
external string curfile # current input file name, set by dumpcontext;
external integer curfpage,curfline # set by dumpcontext;
external procedure dumpcontext # prints where the scanner is;
external simp procedure getnext # sends next high-level token to curtype, curval;

external saf string array fname[0:2] # file name, extension, and directory;
external simp procedure scanfilename # sets up fname[0:2];
external integer bchan # channel for binary input;

define maxpoints=20 # maximum number of points per path;
external integer npts # number of points in current path;
external saf integer array pointi[0:maxpoints+1] # index associated with a point;
external saf real array pointw[0:maxpoints+2] # pen width at a point;
external saf real array pointx[0:maxpoints+1] # x coordinate at a point;
external saf real array pointy[0:maxpoints+1] # y coordinate at a point;
external saf real array tanx,tany[0:maxpoints+1] # tangent direction at a point
	(or (0,0) if METAFONT is to choose the tangent direction);
external saf boolean array pointstab[0:maxpoints+1] # pen width should be stable
	at the current point (i.e., the derivative should be zero);
external saf integer array dpnti[0:maxpoints+1] # pointi for first path in ddraw;
external saf real array dpntx,dpnty,dtanx,dtany[0:maxpoints+1] # pointx,pointy,
	tanx,tany arrays for the first path in ddraw;

external procedure maincontrol # governs all the activities;
comment Declarations internal to MFRAST;

define all_ones=-1 # full word of one bits;
define hw=bitsperwd div 2 # number of bits in a halfword;

IFWAITS
	define xpenmin=-161,xpenmax=126,ypenmax=99 # legal pen range;
	IFSPECRAST redefine xpenmin=-305,xpenmax=270,ypenmax=199; ENDSPECRAST
ENDWAITS
IFTENEX
	define xpenmin=-161,xpenmax=126,ypenmax=99 # legal pen range;
ENDTENEX
IFTOPS20
	define xpenmin=-161,xpenmax=126,ypenmax=99 # legal pen range;
	IFXMEM redefine xpenmin=-305,xpenmax=306,ypenmax=199; ENDXMEM
ENDTOPS20
define	ypenmin=-ypenmax;
comment $\\{xpenmin}-1$ and \\{xpenmax} should be congruent to \\{hw},
	modulo \\{bitsperwd};
define pmemsize=30000 # number of words of pen storage;
external integer pmemptr # pointer to first available place in \\{pmem};

external saf real array spenspec[1:7] # specifications for a special pen;
external procedure makespen # create a new special pen or eraser;

define epensize=ypenmax-ypenmin+1 # maximum length of \&{epen} specs;
external saf integer array epenlspec,epenrspec[0:epensize] # explicit pen specs;
external integer epen0,epenptr # zero point and end of explicit pen specs;
external procedure makeepen # create a new explicit pen or eraser;

external integer curploc # location of the current pen in \\{pmem};
external boolean eraser # the current "pen" really is an eraser;
external procedure resetspen # forgets the previous spen specification, if any;
external procedure resetepen # forgets the previous epen specification, if any;
external procedure resetpens # initializes the current pen;
external procedure clearpens(boolean all) # initializes the pen memory;
external real procedure penadj(real width; integer dir) # boundary of pen position;

IFWAITS define xrastmin=-144,xrastmax=1110,yrastmin=-1700,yrastmax=560 # raster bounds;
IFSPECRAST redefine yrastmin=-700,yrastmax=1000,xrastmax=1290; ENDSPECRAST
IFDVI redefine xrastmax=1074; ENDDVI
IFPRESS redefine xrastmax=xrastmax-10*bitsperwd; comment make room for
	big tables in press proofmode output routines; ENDPRESS
DEBUGONLY redefine xrastmax=750,yrastmin=-100,yrastmax=560;
ENDWAITS
IFTENEX define xrastmin=-72,xrastmax=750,yrastmin=-720,yrastmax=560 # raster bounds;
DEBUGONLY redefine xrastmax=390, yrastmin=-360, yrastmax=360;
ENDTENEX
IFTOPS20 define xrastmin=-72,xrastmax=390,yrastmin=-360,yrastmax=360 # raster bounds;
IFXMEM redefine xrastmin=-360, xrastmax=3606, yrastmin=-2000,yrastmax=2000;
ENDXMEM
DEBUGONLY redefine xrastmax=390, yrastmin=-360, yrastmax=360;
ENDTOPS20
comment \\{xrastmin} and \\{xrastmax+6} should be multiples of \\{bitsperwd};
define rspan=yrastmax+ypenmax+1-yrastmin # words per raster column;
define rcol(x)=⊂((x-(xrastmin+xpenmin)) div bitsperwd)⊃ # column for bit $x$;
define rloc(x,y)=⊂rcol(x)*rspan+y⊃ # allocation function for \\{rast};
define rast0=rloc(xrastmin+xpenmin,yrastmin+ypenmin),
	rast1=rloc(xrastmax+xpenmax,yrastmax+ypenmax);

comment The next task is to allocate the large raster array.  If at
	SAIL, this array can be allocated at compile-time.  But the
	Loader used at PARC (and probably also at other sites
	running Sail under TENEX) has a 128K restriction.  Hence, the
	following hackery;
IFWAITS
external saf integer array rast[rast0:rast1] # the big raster workspace;
ENDWAITS
IFTENEX
external record_class rastrec(saf integer array r);
external record_pointer(rastrec)rastptr;
define rast = ⊂rastrec:r[rastptr]⊃;
ENDTENEX
IFTOPS20
IFXMEM comment The raster will live in sections 2 and up.  Look at the last
	 page of this file for all the macros used to get to it;
ELSEC
external saf integer array rast[rast0:rast1] # the big raster workspace;
ENDC
ENDTOPS20

external integer xleft,xright,ylow,yhigh # active part of the raster;
external procedure clearrast # sets raster to zero;

external procedure drawit(boolean ddrawit) # draw a specified curve;

external integer bbuf # 0 or the number of rows in the next binput entry;
external procedure binin # binary input to the raster;

define ddxmin=-89,ddxmax=414,ddymin=-149,ddymax=330 # datadisc window;
comment $\\{ddxmin}-1$ and \\{ddymax} should be congruent to 18, modulo 36;
comment we must have xrastmin+xpenmin≤ddxmin, ddxmax≤xrastmax+xpenmax,
	yrastmin+ypenmin≤ddymin, ddymax≤yrastmax+ypenmax,
	ddxmax-ddxmin<504, ddymax-ddymin<480;
define ddn=5 # printing is confined to this many lines at bottom of screen;
external procedure ddoutrast # displays the raster on datadisc screen;
comment Declarations internal to MFOUT;

define symbolic=⊂(control land '1000)⊃ # keep list of "known" xy-variables;
define tfmmode=⊂(control land '4000)⊃;
define crsmode=⊂(control land '20000)⊃;
define needchecksum=⊂(control land '24000)⊃ # only crs and tfm currently
	need the value of the tfm checksum computed:  output modes for
	Varian and others will join them later;
define brksize=20 # the number of distinct breaks per character;
external saf integer array brktab[0:1,0:brksize+1] # breaks in increasing order;
external saf integer array brkptr[0:1] # current number of entries in brktab;
external saf integer array bit_id[0:36] # used to identify bits;

external string maintitle # user's description of the font being generated;
external string ofilname # output file name, set by first input;
define numberofmodes=6 # number of output modes supported;
define tfm=1,proof=2,vnt=3,chrs=4,alf=5 # symbolic names of modes;
define rstfnt=6;
IFFNT
define xgpfnt=vnt;
ENDFNT
IFDOVERMODES redefine numberofmodes=8; define doveroc=7; 
	define presswd=8; ENDDOVERMODES
external integer fntptr # words output in fntmode or subglyphs output in crsmode;
external integer rstptr # words output in rstmode;
external integer alfptr # number of words output in crsmode;
external integer alfylow,alfyhigh,alfxleft,alfxright # rectangle to output in crsmode;
external integer antid # identification word for ANT file;
IFVNT
define VNTID=1001 # current VNT ID;
define FNTDIRLEN='1000;
ELSEC
define FNTDIRLEN='400;
ENDC
external saf integer array fntdir[0:FNTDIRLEN-1] # font file directory blocks;
external saf integer array rstdir[0:50+128*4] # directory blocks of font file;
ifc ALPHATYPEMODE thenc
define maxglyph=400 # maximum number of subglyphs per font;
external saf integer array minmax[0:maxglyph+1] # xmin,xmax,bytetimes (packed);
endc

external procedure initout # get TEXOUT started properly;

define proofmemsize=250 # size of proof mode tables;
external procedure proofins(integer xco,yco; string s) # inserts into tree;

external integer nkr,nlg # table pointers in tfm mode;
external saf integer array tfmdir[0:'177] # tfm mode character table;
define wds=8,hts=4,dps=4,ics=6,tgs=2,rems=8 # sizes of tfm fields;
define lgmsk=(1 lsh rems)-1 # maximum lig/kern pointer;
define remd=0 # lig/kern field is right-justified;
define tgmsk=(1 lsh tgs)-1;
define tgd=remd+rems # tag field is just to the left of rem field;
define tagnone=0, taglig=1, taglist=2, tagvar=3;
external saf integer array tfmlg[0:lgmsk] # tfm ligature/kern program;
define ligstep=0, kernstep=1;
external saf real array tfmkr[0:lgmsk] # tfm kern values;
define tfmparsize=24 # max number of tfm parameters;
external saf real array tfmpars[1:tfmparsize] # tfm parameters;
external integer tfmptr # number of tfm parameters stored;
external procedure tfminit # make sure that tfm tables exist;
external boolean isvarchar # I am a built-up character;
external integer varchardata # the four charcodes of the pieces;

external integer yoffset # character to be shifted up this amount by typesetting routine;
external integer xoffset # character to be shifted right this amount by typesetting routine;
external integer alfch # channel being used for crsmode;
external procedure clean # change pixels to allow CRS encoding;
external procedure boundarize # compute boundaries of character;
external integer procedure crscode # encode character for the CRS;

external procedure charclear # initializes parameters for a new character;
external procedure closeout # finishes off the output;
external procedure finishchar # outputs a finished character;
comment Macros for TOPS20 extended memory;

IFCR XMEM THENC
external procedure initxmem;
external procedure closexmem;

define rast!loc(x)=⊂(('2 lsh 18)-rast0+x)⊃; comment i.e. location(rast[x]);

define XQC = ⊂
	quick!code
	label l1, l2, l3, l4;
	⊃;

define XIN = ⊂
	jrst 5, l1;
	l1: 0;
		l2(1);
	l2:
	⊃;

define XOUT = ⊂
	jrst 5, l3;
	l3: 0;
		l4;
	l4:
	⊃;

external integer indir # addressing @INDIR gets the raster item whose 
		number is in register '15;
external integer xtemp # used with VAR!GETS!RAST when there's no place 
		else to put it;
define extend='123000000000 # extend instruction to reach: ;
external integer xblte # extended-blt instruction;

comment rast!gets!expr(rloc,expr) is rast[rloc]←expr;
define rast!gets!expr(rloc,expr)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);
	MOVE '14,ACCESS(EXPR);
	XIN;
	MOVEM '14,@INDIR;
	XOUT;
	END
	⊃;

comment var!gets!rast(var,rloc) is var←rast[rloc];
define var!gets!rast(var,rloc)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);
	XIN;
	MOVE '14,@INDIR;
	XOUT;
	MOVEM '14,ACCESS(VAR);
	END
	⊃;

comment rast!gets!rast!land!expr(rast,expr)
			is rast[rloc]←rast[rloc] land (expr);
define rast!gets!rast!land!expr(rloc,expr)=⊂
	XQC;
	MOVE '13,ACCESS(EXPR);	COMMENT 13←EXPR;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	ANDM '13,@INDIR;
	XOUT;
	END
	⊃;

comment rast!gets!rast!lor!expr(rloc,expr) is rast[rloc]←rast[rloc] lor (expr);
define rast!gets!rast!lor!expr(rloc,expr)=⊂
	XQC;
	MOVE '13,ACCESS(EXPR);	COMMENT 13←EXPR;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	IORM '13,@INDIR;
	XOUT;
	END
	⊃;

comment rast!gets!rast!land!lnot!expr(rloc,expr)
			is rast[rloc]←rast[rloc] land lnot (expr);
define rast!gets!rast!land!lnot!expr(rloc,expr)=⊂
	XQC;
	MOVE '13,ACCESS(EXPR);	COMMENT 13←EXPR;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	ANDCAM '13,@INDIR;
	XOUT;
	END
	⊃;

comment var!gets!rast!lor!var(var,rloc) is var←rast[rloc] lor var;
define var!gets!rast!lor!var(var,rloc)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	MOVE '14,@INDIR;	COMMENT 14←RAST[RLOC];
	XOUT;
	IORM '14,ACCESS(VAR);
	END
	⊃;

comment var!gets!rast!lsh!expr(var,rloc,shift) is var←rast[rloc] lsh shift;
define var!gets!rast!lsh!expr(var,rloc,shift)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	MOVE '14,@INDIR;	COMMENT 14←RAST[RLOC];
	XOUT;
	MOVE  '15,ACCESS(SHIFT);
	LSH   '14,0('15);
	MOVEM '14,ACCESS(VAR);
	END
	⊃;

comment var!gets!rast!lsh!expr!land!const(var,rloc,shift,landconst)=
		⊂var←rast[rloc] lsh shift land const⊃;
define var!gets!rast!lsh!expr!land!const(var,rloc,shift,landconst)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	MOVE '14,@INDIR;	COMMENT 14←RAST[RLOC];
	XOUT;
	MOVE  '15,ACCESS(SHIFT);
	LSH   '14,0('15);
	ANDI  '14,LANDCONST;	COMMENT so landconst<2↑18;
	MOVEM '14,ACCESS(VAR);
	END
	⊃;

comment var!gets!rast!lsh!const!land!const(var,rloc,shiftconst,landconst)=
		⊂var←rast[rloc] lsh shiftconst land landconst⊃;
define var!gets!rast!lsh!const!land!const(var,rloc,shiftconst,landconst)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	MOVE '14,@INDIR;	COMMENT 14←RAST[RLOC];
	XOUT;
	LSH   '14,SHIFTCONST;
	ANDI  '14,LANDCONST;	COMMENT so landconst<2↑18;
	MOVEM '14,ACCESS(VAR);
	END
	⊃;

comment var!gets!rast!lsh!const!lsh!const(var,rloc,ashiftconst,bshiftconst)=
		⊂var←rast[rloc] lsh ashiftconst lsh bshiftconst⊃;
define var!gets!rast!lsh!const!lsh!const(var,rloc,ashiftconst,bshiftconst)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	MOVE '14,@INDIR;	COMMENT 14←RAST[RLOC];
	XOUT;
	LSH   '14,ASHIFTCONST;
	LSH   '14,BSHIFTCONST;
	MOVEM '14,ACCESS(VAR);
	END
	⊃;

comment var!gets!rast!lsh!expr!lor!var(var,rloc,shift)
			is var←(rast[rloc] lsh shift) lor var;
define var!gets!rast!lsh!expr!lor!var(var,rloc,shift)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	MOVE '14,@INDIR;	COMMENT 14←RAST[RLOC];
	XOUT;
	MOVE  '15,ACCESS(SHIFT);
	LSH   '14,0('15);
	IORM  '14,ACCESS(VAR);
	END
	⊃;

comment var!gets!two!rast!cols(var,rloc,shift) is
		 var←(rast[rloc] lsh shift)+(rast[rloc+rspan] lsh shift-36);
define var!gets!two!rast!cols(var,rloc,shift)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	MOVE '13,@INDIR;	COMMENT 13←RAST[RLOC];
	ADDI '15,RSPAN;		COMMENT 15←RLOC+RSPAN;
	MOVE '14,@INDIR;	COMMENT 14←RAST[RLOC+RSPAN];
	XOUT;
	MOVE '15,ACCESS(SHIFT);	COMMENT 15←SHIFT;
	LSH  '13,0('15);	COMMENT 13←RAST[RLOC] LSH SHIFT;
	LSH  '14,-36('15);	COMMENT 14←RAST[RLOC+RSPAN] LSH (SHIFT-36);
	ADD  '13,'14;		COMMENT 13←RESULT;
	MOVEM '13,ACCESS(VAR);
	END
	⊃;

define var!gets!seven!rast!lors(var,rloc)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	SETMI '13,@INDIR;	COMMENT 13←ADDR(RAST[RLOC]);
	MOVE  '14,0('13);
	IOR   '14,1('13);
	IOR   '14,2('13);
	IOR   '14,3('13);
	IOR   '14,4('13);
	IOR   '14,5('13);
	IOR   '14,6('13);
	XOUT;
	MOVEM '14,ACCESS(VAR);
	END
	⊃;

define var!gets!seven!rast!lands(var,rloc)=⊂
	XQC;
	MOVE '15,ACCESS(RLOC);	COMMENT 15←RLOC;
	XIN;
	SETMI '13,@INDIR;	COMMENT 13←ADDR(RAST[RLOC]);
	MOVE  '14,0('13);
	AND   '14,1('13);
	AND   '14,2('13);
	AND   '14,3('13);
	AND   '14,4('13);
	AND   '14,5('13);
	AND   '14,6('13);
	XOUT;
	MOVEM '14,ACCESS(VAR);
	END
	⊃;

define xbltit(toloc,fromloc,bltcnt)=⊂
	XQC;
	MOVE '13,ACCESS(BLTCNT);
	MOVE '14,ACCESS(FROMLOC);
	MOVE '15,ACCESS(TOLOC);
	XIN;
	EXTEND '13,ACCESS(XBLTE);
	XOUT;
	END
	⊃;
ELSEC
define
	rast!gets!expr(rloc,expr)=
		⊂rast[rloc]←expr⊃,
	var!gets!rast(var,rloc)=
		⊂var←rast[rloc]⊃,
	rast!gets!rast!land!expr(rloc,expr)=
		⊂rast[rloc]←rast[rloc] land (expr)⊃,
	rast!gets!rast!lor!expr(rloc,expr)=
		⊂rast[rloc]←rast[rloc] lor (expr)⊃,
	rast!gets!rast!land!lnot!expr(rloc,expr)=
		⊂rast[rloc]←rast[rloc] land lnot (expr)⊃,
	var!gets!rast!lor!var(var,rloc)=
		⊂var←rast[rloc] lor var⊃,
	var!gets!rast!lsh!expr(var,rloc,shift)=
		⊂var←rast[rloc] lsh (shift)⊃,
	var!gets!rast!lsh!expr!land!const(var,rloc,shift,landconst)=
		⊂var←rast[rloc] lsh (shift) land (landconst)⊃,
	var!gets!rast!lsh!const!land!const(var,rloc,shiftconst,landconst)=
		⊂var←rast[rloc] lsh (shiftconst) land (landconst)⊃,
	var!gets!rast!lsh!const!lsh!const(var,rloc,ashiftconst,bshiftconst)=
		⊂var←rast[rloc] lsh (ashiftconst) lsh (bshiftconst)⊃,
	var!gets!rast!lsh!expr!lor!var(var,rloc,shift)=
		⊂var←(rast[rloc] lsh (shift)) lor var⊃,
	var!gets!two!rast!cols(var,rloc,shift)=
		⊂var←(rast[rloc] lsh (shift))
			+(rast[rloc+rspan] lsh ((shift)-36))⊃,
	var!gets!seven!rast!lors(var,rloc)=
		⊂var←rast[rloc] lor rast[rloc+1] lor rast[rloc+2] lor
			rast[rloc+3] lor rast[rloc+4] lor
			rast[rloc+5] lor rast[rloc+6]⊃,
	var!gets!seven!rast!lands(var,rloc)=
		⊂var←rast[rloc] land rast[rloc+1] land rast[rloc+2] land
			rast[rloc+3] land rast[rloc+4] land
			rast[rloc+5] land rast[rloc+6]⊃
	;

ENDC